* Игра в домино.
* Используются англоязычные слова для написания команд.
* Программа КОНЦЕПТ, 30.09.2009, www.gendoc.ru

* Переключение с русского на английский азык
english

* обозначения:
* кл - колбаса, левый край
* кп - колбаса, правый край
* фл - фишка, левый край
* фп - фишка, правый край

function Протокол текст
  >[текст] 
return

function ПротоколN текст
  for [текст] 
    >[$LoopObj]
  next 
return

function Ставь_фишку фишка_проверенная
  mem local варианты вариант кл кп фл фп

  str get кл [КОЛБАСА] 1
  str get кп [КОЛБАСА] (str count $result [КОЛБАСА] )
  str get фл [фишка_проверенная] 1
  str get фп [фишка_проверенная] 2

  Ход_допустимый? варианты [фишка_проверенная]

* Приставить фишку к колбасе
  if [КОЛБАСА] == {}
    list concat КОЛБАСА [КОЛБАСА] [фишка_проверенная]   
  else
    list head вариант [варианты]
    if  [КТО_ХОДИТ] == игрок
      if (list count $result [варианты] ) == 2
        if (expr and $result (expr != $result [кл] [кп] ) (expr != $result [фл] [фп] ) )
          input men1 вариант "Как ставить фишку [фишка_проверенная] (кф)? [КОЛБАСА]" [варианты]
        end
      end
    end

    select [вариант]
    case лл
      list concat КОЛБАСА "[фп][фл]" [КОЛБАСА]
    case лп
      list concat КОЛБАСА "[фл][фп]" [КОЛБАСА]
    case пл
      list concat КОЛБАСА [КОЛБАСА] "[фл][фп]"
    case пп
      list concat КОЛБАСА [КОЛБАСА] "[фп][фл]"
    endselect
  end

* Убрать фишку с руки
  if [КТО_ХОДИТ] == компьютер
    sop minus РУКА_КОМПЬЮТЕРА [РУКА_КОМПЬЮТЕРА] [фишка_проверенная]
    Протокол "Комп: [фишка_проверенная] [РУКА_КОМПЬЮТЕРА]"
  else
    sop minus РУКА_ИГРОКА [РУКА_ИГРОКА] [фишка_проверенная]
    Протокол "Игрок: [фишка_проверенная] [РУКА_ИГРОКА]"
  end
return

function Ход_допустимый? варианты_установки фишка_кандидат
  mem local кл кп фл фп
  set [варианты_установки] {}

  if [КОЛБАСА] == {}
    set [варианты_установки] лл;лп;пл;пп
  else
    str get кл [КОЛБАСА] 1
    str get кп [КОЛБАСА] (str count $result [КОЛБАСА] )
    str get фл [фишка_кандидат] 1
    str get фп [фишка_кандидат] 2
    
    if [кл] == [фл]
      sop or [варианты_установки] [[варианты_установки]] лл
    end
    if [кл] == [фп]
      sop or [варианты_установки] [[варианты_установки]] лп
    end
    if [кп] == [фл]
      sop or [варианты_установки] [[варианты_установки]] пл
    end
    if [кп] == [фп]
      sop or [варианты_установки] [[варианты_установки]] пп
    end
  end
return

function Есть_чем_ходить? варианты_ходов на_руке
  mem local варианты_установки_фишки
  set [варианты_ходов] {}

  if [КОЛБАСА]
    for [на_руке]
      Ход_допустимый? варианты_установки_фишки [$LoopObj]
      if [варианты_установки_фишки]
        sop or [варианты_ходов] [[варианты_ходов]] [$LoopObj]
      end
    next
  else
    set [варианты_ходов] [на_руке]  
  end
return

function Иди_на_базар рука
  mem local кол фишка варианты взято_с_базара

  set кол 0 
  set взято_с_базара {}
  for [КОЛОДА]
    expr + кол [кол] 1
    list random фишка [КОЛОДА]
    sop minus КОЛОДА [КОЛОДА] [фишка]
    sop or [рука] [[рука]] [фишка] 
    list concat взято_с_базара [взято_с_базара] [фишка]

    Ход_допустимый? варианты [фишка]
    if [варианты]
      set $LoopList {}
    end
  next

  if [кол] > 0
    show msg "[рука] сходил на базар [кол] раз!"
    Протокол "[рука] сходил на базар [кол] раз! [взято_с_базара]"
  end
return

function Ход_компьютера
  mem local фишка варианты дупель_найден фл фп
  set КТО_ХОДИТ компьютер

  Есть_чем_ходить? варианты [РУКА_КОМПЬЮТЕРА]
*  show msg "Варианты компьютера: [варианты] Колбаса: [КОЛБАСА] На руке: [РУКА_КОМПЬЮТЕРА]"
  if [варианты] == {}
    Иди_на_базар РУКА_КОМПЬЮТЕРА
  end 

  if [РУКА_КОМПЬЮТЕРА]
    Есть_чем_ходить? варианты [РУКА_КОМПЬЮТЕРА]
    if [варианты]

    * Здесь логика выбора оптимального хода компьютером !!!
      list invert варианты [варианты]
      set дупель_найден ''
      for [варианты]
        str get фл [$LoopObj] 1
        str get фп [$LoopObj] 2
        if [фл] == [фп]
          set дупель_найден [$LoopObj]
          set $LoopList {}
        end
      next
      if [дупель_найден]
        set фишка [дупель_найден]
      else
        list get фишка [варианты] 1
      end

      Ставь_фишку [фишка]
    else
      show msg "Компьютер катом."
      Протокол "Компьютер катом. [РУКА_КОМПЬЮТЕРА] [КОЛОДА]"
    end
  end

  Игра_окончена?
return

function Ход_игрока
  mem local фишка варианты рука_с_подсказкой вариант
  set КТО_ХОДИТ игрок

  Есть_чем_ходить? варианты [РУКА_ИГРОКА]
*  show msg "Варианты игрока: [варианты] Колбаса: [КОЛБАСА] На руке: [РУКА_ИГРОКА]"
  if [варианты] == {}
    Иди_на_базар РУКА_ИГРОКА
  end 

  if [РУКА_ИГРОКА]
    Есть_чем_ходить? варианты [РУКА_ИГРОКА]
    if [варианты]
      set рука_с_подсказкой {}
      for [РУКА_ИГРОКА]
        sop and вариант [$LoopObj] [варианты]
        if [вариант]
          list concat рука_с_подсказкой [рука_с_подсказкой] ">[$LoopObj]"
        else
          list concat рука_с_подсказкой [рука_с_подсказкой] " [$LoopObj]"
        end
      next

      for 1
        input men1 фишка "Колбаса: [КОЛБАСА]" [рука_с_подсказкой]
        str delete фишка [фишка] 1 1

        Ход_допустимый? варианты [фишка]
        if [варианты]
          Ставь_фишку [фишка]
        else
          show msg "Недопустимый ход [фишка]!"
          set $LoopList 1
        end
      next
    else
      show msg "Игрок катом."
      Протокол "Игрок катом. [РУКА_ИГРОКА] [КОЛОДА]"
    end
  end

  Игра_окончена?
return

function Игра_окончена?
  mem local игра_окончена очки_комп очки_игрок победитель
  mem local кл кп фл фп длина кол
  set игра_окончена нет 

  if [КТО_ХОДИТ] == компьютер
    if [РУКА_КОМПЬЮТЕРА] == {}
      set игра_окончена да 
    end
  else
    if [РУКА_ИГРОКА] == {}
      set игра_окончена да 
    end   
  end

* или обоим нечем ходить и на базаре нет допустимых фишек (РЫБА)
  str count длина [КОЛБАСА]
  str get кл [КОЛБАСА] 1
  str get кп [КОЛБАСА] [длина]
  if [кл] == [кп]
    set кол 0
    for [КОЛБАСА]
      str get фл [$LoopObj] 1
      str get фп [$LoopObj] 2
      if [фл] == [кл]
        expr + кол [кол] 1
      end
      if [фп] == [кп]
        expr + кол [кол] 1
      end
    next
    if [кол] = 8
      set игра_окончена да 
      show msg 'Рыба!!!'
    end
  end
  
  if [игра_окончена] == да
    Подсчет_очков_на_руке [РУКА_КОМПЬЮТЕРА]
    set очки_комп [Подсчет_очков_на_руке]

    Подсчет_очков_на_руке [РУКА_ИГРОКА]
    set очки_игрок [Подсчет_очков_на_руке]

    >
    >Результат
    >  Компьютер: [очки_комп] - Игрок: [очки_игрок]
    >  Колбаса: [КОЛБАСА]
    >  Компьютер: [РУКА_КОМПЬЮТЕРА]
    >  Игрок: [РУКА_ИГРОКА]
    >  Колода: [КОЛОДА]

    set победитель ничья
    if [очки_комп] < [очки_игрок]
      set победитель компьютер
      show msg "Я выиграл :)!"
    end
    if [очки_комп] > [очки_игрок]
      set победитель игрок
      show msg "Вы выиграли :(!"
    end
    if [очки_комп] = [очки_игрок]
      show msg "Боевая ничья!"
    end

    stop
  end
return

function Подсчет_очков_на_руке на_руке
  mem local фл фп
  set Подсчет_очков_на_руке 0

  if [на_руке] == 00
    set Подсчет_очков_на_руке 10
  else
    for фишка [на_руке]
      str get фл [фишка] 1
      str get фп [фишка] 2
      set Подсчет_очков_на_руке (expr + $result [Подсчет_очков_на_руке] [фл] [фп] )   
    next
  end
return

function Генерация_колоды
  mem local x y

  set КОЛОДА {}
  list gen ТОЧКИ 0 6
  for x [ТОЧКИ]
    for y [ТОЧКИ]
      if [x] <= [y]
        sop or КОЛОДА [КОЛОДА] "[x][y]"
      end
    next
  next
return

function Сдача_фишек набор_фишек
  mem local рука фишка

  set рука {}
  for 1;2;3;4;5;6;7
    list random фишка [КОЛОДА]
    sop minus КОЛОДА [КОЛОДА] [фишка]
    sop or рука [рука] [фишка]
  next
  set [набор_фишек] [рука]
return

* Начало основного кода

mem clear
set КОЛБАСА {}

Генерация_колоды
Сдача_фишек РУКА_КОМПЬЮТЕРА
Сдача_фишек РУКА_ИГРОКА

ПротоколN "Протокол игры в домино;;Начальная раздача"
Протокол  "   Компьютер:  [РУКА_КОМПЬЮТЕРА]"
Протокол  "   Игрок: [РУКА_ИГРОКА]"

set ХОД 1
while [ХОД]
  Протокол ''
  Протокол "ход N [ХОД]"
  Протокол "Колбаса: [КОЛБАСА]"
 
  Ход_компьютера
  Ход_игрока

  expr + ХОД [ХОД] 1 
loop